home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / lisp / qpfile-compl.el < prev    next >
Encoding:
Text File  |  1992-05-26  |  2.3 KB  |  69 lines
  1. ;; SCCS: @(#)89/11/20 qpfile-compl.el    1.2
  2. ;; file-compl.el
  3. ;; filename completion for anywhere in Emacs
  4. ;; Paul Davis <davis%scr.slb.com@relay.cs.net> July 1988
  5. ;; Copyright (C) Schlumberger Cambridge Research, 1989
  6. ;;
  7. ;; perhaps better to do this at the source level, but its
  8. ;; quick enough and a fair bit more obvious whats going on.
  9.  
  10. (defvar not-filename-regexp "\\(^\\|[] ^<>\"'`?$%{}|&*()#!@^\;\t\n]\\)"
  11.   "grouped regexp specifying characters considered to be excluded 
  12. from filenames. Based on csh special characters, coupled with a
  13. brief consideration of C and Lisp syntax.")
  14.  
  15. (defun shell-filename-complete ()
  16.   (interactive)
  17.   (let* ((filename (expand-file-name (grab-filename)))
  18.     (partial-name (file-name-nondirectory filename)))
  19.     (if (null (setq directory (file-name-directory filename)))
  20.     (error "no such directory"))
  21.     (if (not (null
  22.           (setq completion-list
  23.             (mapcar 'list
  24.                 (file-name-all-completions 
  25.                  partial-name directory)))))
  26.     (progn
  27.       (setq completion (try-completion partial-name completion-list))
  28.       (cond ((eq completion t))
  29.         ;; probably always grabbed by try-completion but throw it in anyway...
  30.         ((null completion)
  31.          (message "No such file or directory")
  32.          (ding))
  33.         ((not (string= partial-name completion))
  34.          (delete-region
  35.           (save-excursion 
  36.             (re-search-backward partial-name 
  37.                     (save-excursion
  38.                       (beginning-of-line)(point))) (point))
  39.           (point))
  40.          (insert completion))
  41.         (t
  42.          (message "Making completion list...")
  43.          (let ((list (all-completions partial-name completion-list)))
  44.            (with-output-to-temp-buffer "*Help*"
  45.              (display-completion-list list))
  46.            (message "Making completion list... done")))))
  47.       (progn
  48.     (message "No such file or directory")
  49.     (ding)))))
  50.   
  51.  
  52. (defun grab-filename ()
  53.   "Gets the filename preceeding point. We have to assume 
  54. something about characters not legal in filenames, because Un*x
  55. only disallows / and NULL. This is determined by not-filename-regexp,
  56. which is a regexp specifying a set of characters NOT legal in
  57. filenames. It might be nice to add things to mode hooks to set
  58. this for different modes, but the default is a guess at one
  59. that should be reasonably general."
  60.   (buffer-substring 
  61.    (save-excursion
  62.      (re-search-backward not-filename-regexp (point-min) t)
  63.      (if (bolp)
  64.      (point)
  65.        (1+ (point))))
  66.    (point)))
  67.  
  68.  
  69.